Eighth Week: Text Analysis in R

با استفاده از بسته gutenberg داده های لازم را به دست آورید و به سوالات زیر پاسخ دهید.

---

۱. چارلز دیکنز نویسنده معروف انگلیسی بالغ بر چهارده رمان (چهارده و نیم) نوشته است. متن تمامی کتاب های او را دانلود کنید و سپس بیست لغت برتر استفاده شده را به صورت یک نمودار ستونی نمایش دهید. (طبیعتا باید ابتدا متن را پاکسازی کرده و stopping words را حذف نمایید تا به کلماتی که بار معنایی مشخصی منتقل می کنند برسید.)

## ── Attaching packages ────────────────────────────────── tidyverse 1.2.1 ──

## ✔ ggplot2 2.2.1     ✔ purrr   0.2.4
## ✔ tibble  1.4.2     ✔ dplyr   0.7.4
## ✔ tidyr   0.8.0     ✔ stringr 1.3.0
## ✔ readr   1.1.1     ✔ forcats 0.2.0

## ── Conflicts ───────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

## Loading required package: RColorBrewer

## 
## Attaching package: 'igraph'

## The following objects are masked from 'package:dplyr':
## 
##     as_data_frame, groups, union

## The following objects are masked from 'package:purrr':
## 
##     compose, simplify

## The following object is masked from 'package:tidyr':
## 
##     crossing

## The following object is masked from 'package:tibble':
## 
##     as_data_frame

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

## Loading required package: NLP

## 
## Attaching package: 'NLP'

## The following object is masked from 'package:ggplot2':
## 
##     annotate

## Loading required package: lattice

## 
## Attaching package: 'caret'

## The following object is masked from 'package:purrr':
## 
##     lift

## 
## Attaching package: 'text2vec'

## The following object is masked from 'package:topicmodels':
## 
##     perplexity

## The following object is masked from 'package:igraph':
## 
##     normalize

## 
## Attaching package: 'data.table'

## The following objects are masked from 'package:dplyr':
## 
##     between, first, last

## The following object is masked from 'package:purrr':
## 
##     transpose

## Loading required package: Matrix

## 
## Attaching package: 'Matrix'

## The following object is masked from 'package:tidyr':
## 
##     expand

## Loading required package: foreach

## 
## Attaching package: 'foreach'

## The following objects are masked from 'package:purrr':
## 
##     accumulate, when

## Loaded glmnet 2.0-16

## Determining mirror for Project Gutenberg from http://www.gutenberg.org/robot/harvest

## Using mirror http://aleph.gutenberg.org

custom_stop_words <- bind_rows(data_frame(word = c("miss"), 
                                          lexicon = c("custom")), 
                               stop_words)

book_names = c('ThePickwickPapers','OliverTwist','NicholasNickleby','TheOldCuriosityShop','BarnabyRudge',                  'MartinChuzzlewit','DombeyandSon','DavidCopperfield','ATaleofTwoCities',
                  'HardTimes','LittleDorrit','GreatExpectations','OurMutualFriend',
                  'TheMysteryofEdwinDrood','BleakHouse')
book_id <- c(580,730,967,700,917,968,821,766,98,786,963,1400,883,564,1023)

all_data <- rbind(ThePickwickPapers,OliverTwist,NicholasNickleby,TheOldCuriosityShop,BarnabyRudge,
                  MartinChuzzlewit,DombeyandSon,DavidCopperfield,ATaleofTwoCities,
                  HardTimes,LittleDorrit,GreatExpectations,OurMutualFriend,
                  TheMysteryofEdwinDrood,BleakHouse)
all_data %>%
  unnest_tokens(word, text) %>%
  filter(!str_to_lower(word) %in% custom_stop_words$word) %>% 
  filter(str_length(word)>1) %>% 
  filter(!str_detect(word,"\\d")) %>%  count(word,sort = TRUE) %>%
  ungroup() %>%
  mutate(word = factor(word, levels = rev(unique(word)))) -> most_words
most_words %>%   
  head(20) %>% 
  ggplot(aes(x = word,y = n)) +
  geom_bar(stat='identity',colour="white") +
  coord_flip() 

---

۲. ابر لغات ۲۰۰ کلمه پرتکرار در رمان های چارلز دیکنز را رسم نمایید. این کار را با بسته wordcloud2 انجام دهید. برای دانلود می توانید به لینک زیر مراجعه کنید.

https://github.com/Lchiffon/wordcloud2

با استفاده از عکسی که در ابتدا متن آمده ابر لغاتی مانند شکل زیر رسم کنید. (راهنمایی: از ورودی figpath در دستور wordcloud2 استفاده نمایید.مثالی در زیر آورده شده است.)

library(wordcloud2)
most_words %>% arrange(-n) %>% slice(1:400) %>% 
wordcloud2(.,figPath = "images/dickens1_1.png", size = 0.1,color = "black")

---

۳. اسم پنج شخصیت اصلی در هر رمان دیکنز را استخراج کنید و با نموداری تعداد دفعات تکرار شده بر حسب رمان را رسم نمایید. (مانند مثال کلاس در رسم اسامی شخصیت ها در سری هر پاتر)

all_data %>% 
  unnest_tokens(word, text,to_lower=FALSE,drop=FALSE) %>% 
  filter(!str_to_lower(word) %in% custom_stop_words$word) %>% 
  filter(str_length(word)>1) %>% 
  filter(!str_detect(word,"\\d")) %>%
  group_by(gutenberg_id) %>% 
  count(word,sort = TRUE) %>%
  arrange(desc(n)) %>% 
  mutate(proper = !word %in% str_to_lower(word)) %>% filter(proper==TRUE) -> person_book

for (i in 1:length(book_id)){
 print( person_book %>% filter(gutenberg_id==book_id[i]) %>% slice(1:5) %>% 
    ggplot(aes(x=word,y=n,fill=word))+ geom_bar(stat='identity',colour="white")+coord_flip()+ggtitle(c(toString(book_names[book_id==book_id[i]]))))
}

---

۴. در بسته tidytext داده ایی به نام sentiments وجود دارد که فضای احساسی لغات را مشخص می نماید. با استفاده از این داده نمودار ۲۰ لغت برتر negative و ۲۰ لغت برتر positive را در کنار هم رسم نمایید. با استفاده از این نمودار فضای حاکم بر داستان چگونه ارزیابی می کنید؟ (به طور مثال برای کتاب داستان دو شهر فضای احساسی داستان به ترتیب تکرر در نمودار زیر قابل مشاهده است.)

i add miss world from custom_stop_words beacase it was used as young lady name in story .

all_books <-all_data %>%
  group_by(gutenberg_id) %>%
  mutate(linenumber = row_number(),
         chapter = cumsum(str_detect(text, regex("^chapter [\\divxlc]", 
                                                 ignore_case = TRUE)))) %>%
  ungroup() %>%
  unnest_tokens(word, text) %>% 
  filter(!(word %in% custom_stop_words$word)) 


bing_word_counts <- all_books %>%
  inner_join(get_sentiments("bing")) %>%
  count(word, sentiment, sort = TRUE) %>%
  ungroup()

## Joining, by = "word"

bing_word_counts

## # A tibble: 4,383 x 3
##    word   sentiment     n
##    <chr>  <chr>     <int>
##  1 poor   negative   2341
##  2 love   positive   1673
##  3 dark   negative   1332
##  4 pretty positive   1314
##  5 master positive   1218
##  6 hard   negative   1204
##  7 doubt  negative   1127
##  8 happy  positive   1114
##  9 dead   negative   1113
## 10 strong positive   1103
## # ... with 4,373 more rows

bing_word_counts %>%
  group_by(sentiment) %>%
  top_n(10) %>%
  ungroup() %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment",
       x = NULL) +
  coord_flip()

## Selecting by n

---

۵. متن داستان بینوایان را به ۲۰۰ قسمت مساوی تقسیم کنید. برای هر قسمت تعداد لغات positive و negative را حساب کنید و سپس این دو سری زمانی را در کنار هم برای مشاهده فضای احساسی داستان رسم نمایید.

library(tidyr)
les_mis <- gutenberg_download(135)
tidy_mis <- les_mis %>%
  mutate(linenumber = row_number()) %>% 
  unnest_tokens(word, text) %>% 
  filter(!(word %in% custom_stop_words$word))

 tidy_mis %>% 
 inner_join(get_sentiments("bing")) %>% count(gutenberg_id, index = linenumber %/% 200, sentiment) %>% 
  ggplot(aes(index, n, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment",
       x = NULL) +
  coord_flip()

## Joining, by = "word"

---

۶. ابتدا ترکیبات دوتایی کلماتی که پشت سر هم می آیند را استخراج کنید و سپس نمودار ۳۰ جفت لغت پرتکرار را رسم نمایید.

I do this for all books of dickens together .

all_data %>%
  unnest_tokens(bigram, text,token = "ngrams", n = 2) %>% 
  mutate(bigram = factor(bigram, levels = rev(unique(bigram))))  ->
  most_biwords
 
 bigrams_separated <- most_biwords %>%
  separate(bigram, c("word1", "word2"), sep = " ")

bigrams_filtered <- bigrams_separated %>%
  filter(!(word1 %in% stop_words$word)) %>%
  filter(!(word2 %in% stop_words$word))

# new bigram counts:
bigram_counts <- bigrams_filtered %>% 
  count(word1, word2, sort = TRUE)

bigram_counts  %>%
  head(30) -> bigram_30_uni

bigrams_united <- bigram_30_uni %>%
  unite(bigram, word1, word2, sep = " ")
bigrams_united

## # A tibble: 30 x 2
##    bigram             n
##    <chr>          <int>
##  1 ha ha            579
##  2 sir replied      432
##  3 sir leicester    431
##  4 miss tox         346
##  5 sir returned     309
##  6 captain cuttle   268
##  7 dear sir         267
##  8 sir mulberry     250
##  9 miss havisham    236
## 10 low voice        207
## # ... with 20 more rows

bigrams_united %>%  ggplot(aes(x=bigram,y=n,fill=bigram))+ geom_bar(stat='identity',colour="white")+coord_flip()

---

۷. جفت کلماتی که با she و یا he آغاز می شوند را استخراج کنید. بیست فعل پرتکراری که زنان و مردان در داستان های دیکنز انجام می دهند را استخراج کنید و نمودار آن را رسم نمایید.

bigrams_separated %>% filter((word1=='she')|(word1=='he')|(word1=='She')|(word1=='He')) %>% count(word1,word2) %>%  group_by(word1) %>%
  top_n(10) %>% ungroup() %>%
  mutate(word2 = reorder(word2, n)) %>%
  ggplot(aes(word2, n, fill = word1)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~word1, scales = "free_y") +
  labs(y = "Contribution to sentiment",
       x = NULL) +
  coord_flip()

## Selecting by n

---

۸. برای کتاب های دیکنز ابتدا هر فصل را جدا کنید. سپی برای هر فصل 1-gram, 2-gram را استخراج کنید. آیا توزیع N-gram در کارهای دیکنز یکسان است؟ با رسم نمودار هم این موضوع را بررسی کنید.

1-gram as I undrestand from question i give you all 1 gram density plot of 1-gram for all chapters in each book .

all_books <-all_data %>%
  group_by(gutenberg_id) %>%
  mutate(linenumber = row_number(),
         chap = cumsum( str_detect(text, regex("^DETAILED CONTENTS", 
                                                 ignore_case = TRUE) )))  %>% 
        mutate(chapter= cumsum(str_detect(text, regex("^chapter [\\divxlc]", 
                                                 ignore_case = TRUE)))) %>% 
  ungroup() %>%
  unnest_tokens(word, text) %>% 
  filter(!word %in% custom_stop_words$word) 

for (i in 1:length(book_id)){
 print( all_books %>% filter(gutenberg_id==book_id[i]) %>% 
    ggplot(aes(x=word,color=chapter,group=chapter))+ geom_density()+coord_flip()+ggtitle(c(toString(book_names[book_id==book_id[i]]))))
}

as it can be seen there almost same distribultion for one gram for dikckens book . 2-gram I do same for 2-gram for 5 book of dikens in here .

all_data %>%
  group_by(gutenberg_id) %>%
  mutate(linenumber = row_number(),
         chap = cumsum( str_detect(text, regex("^DETAILED CONTENTS", 
                                                 ignore_case = TRUE) )))  %>% 
        mutate(chapter= cumsum(str_detect(text, regex("^chapter [\\divxlc]", 
                                                 ignore_case = TRUE)))) %>% 
  ungroup() %>%
  unnest_tokens(bigram, text,token = "ngrams", n = 2) %>% 
  mutate(bigram = factor(bigram, levels = rev(unique(bigram))))  ->
  most_biwords
 
 bigrams_separated <- most_biwords %>%
  separate(bigram, c("word1", "word2"), sep = " ")

bigrams_filtered <- bigrams_separated %>%
  filter(!(word1 %in% stop_words$word)) %>%
  filter(!(word2 %in% stop_words$word))

bigrams_united <- bigrams_filtered  %>%
  unite(bigram, word1, word2, sep = " ")
bigrams_united

## # A tibble: 388,674 x 5
##    gutenberg_id linenumber  chap chapter bigram           
##           <int>      <int> <int>   <int> <chr>            
##  1           98          2     0       0 NA NA            
##  2           98          3     0       0 french revolution
##  3           98          4     0       0 NA NA            
##  4           98          5     0       0 charles dickens  
##  5           98          6     0       0 NA NA            
##  6           98          7     0       0 NA NA            
##  7           98          8     0       0 NA NA            
##  8           98          9     0       0 NA NA            
##  9           98         10     0       0 NA NA            
## 10           98         12     0       0 NA NA            
## # ... with 388,664 more rows

for (i in 1:5){
 print( bigrams_united %>% filter(gutenberg_id==book_id[i]) %>% 
    ggplot(aes(x=bigram,color=chapter,group=chapter))+ geom_density()+coord_flip()+ggtitle(c(toString(book_names[book_id==book_id[i]]))))
}

it can be seen that they have same normal distribution either . ***

۹. برای آثار ارنست همینگوی نیز تمرین ۸ را تکرار کنید. آیا بین آثار توزیع n-grams در بین آثار این دو نویسنده یکسان است؟

---

۱۰. بر اساس دادهایی که در تمرین ۸ و ۹ از آثار دو نویسنده به دست آوردید و با استفاده از N-gram ها یک مدل لاجستیک برای تشخیص صاحب اثر بسازید. خطای مدل چقدر است؟ برای یادگیری مدل از کتاب کتاب الیور تویست اثر دیکنز و کتاب پیرمرد و دریا استفاده نکنید. پس از ساختن مدل برای تست کردن فصل های این کتابها را به عنوان داده ورودی به مدل بدهید. خطای تشخیص چقدر است؟